home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tables / ZTBALL.MAC.f < prev   
Encoding:
Text File  |  1989-03-04  |  6.8 KB  |  273 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 1.1
  3. C---------------------------------------------------------
  4. C
  5. C  ZTBACC - 05 MAR 84
  6. C           TIE LIBRARY
  7. C           TABLES SUPPLEMENTARY LIBRARY
  8. C
  9. C  ACCESS A TABLE BY ENTRY NUMBER
  10. C
  11. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR 'NOERR'.
  12. C
  13.       INTEGER FUNCTION ZTBACC(ENTRY, KEY, KEYLEN, VALUES, ARRAY)
  14.  
  15.       INTEGER KEYLEN, I, OFFSET, ENTRY
  16.       INTEGER ARRAY(*), KEY(*), VALUES(*)
  17.  
  18.       ZTBACC = -1
  19.       IF(ARRAY(1) .NE.     116) RETURN
  20.       IF(ENTRY    .LE.        0) RETURN
  21.       IF(ENTRY    .GT. ARRAY(4)) RETURN
  22.  
  23.       OFFSET = (ARRAY(3) + 2) * (ENTRY - 1) + 10
  24.       KEYLEN = ARRAY(OFFSET - 1)
  25.  
  26.       DO 10 I = 1, ARRAY(3)
  27.         VALUES(I) = ARRAY(OFFSET + I)
  28.    10 CONTINUE
  29.  
  30.       OFFSET = ARRAY(OFFSET) - 1
  31.       DO 20 I = 1, KEYLEN
  32.         KEY(I) = ARRAY(OFFSET +  I)
  33.    20 CONTINUE
  34.  
  35.       ZTBACC = -2
  36.  
  37.       RETURN
  38.       END
  39. C----------------------------------------------------------------------
  40. C
  41. C  ZTBUPD - 27 SEP 84
  42. C           TIE LIBRARY
  43. C           TABLES SUPPLEMENTARY LIBRARY
  44. C
  45. C  UPDATE A TABLE ENTRY BY ENTRY NUMBER
  46. C
  47. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR 'NOERR'.
  48. C
  49.       INTEGER FUNCTION ZTBUPD(ENTRY, VALUES, ARRAY)
  50.  
  51.       INTEGER I, OFFSET, ENTRY
  52.       INTEGER ARRAY(*), VALUES(*)
  53.  
  54.       ZTBUPD = -1
  55.       IF(ARRAY(1) .NE.     116) RETURN
  56.       IF(ENTRY    .LE.        0) RETURN
  57.       IF(ENTRY    .GT. ARRAY(4)) RETURN
  58.  
  59.       OFFSET = (ARRAY(3) + 2) * (ENTRY - 1) + 10
  60.  
  61.       DO 10 I = 1, ARRAY(3)
  62.         ARRAY(OFFSET + I) = VALUES(I)
  63.    10 CONTINUE
  64.  
  65.       ZTBUPD = -2
  66.  
  67.       RETURN
  68.       END
  69. C----------------------------------------------------------------------
  70. C
  71. C  ZTBFND - 05 MAR 84
  72. C           TIE LIBRARY
  73. C           TABLES SUPPLEMENTARY LIBRARY
  74. C
  75. C  FIND AN ENTRY IN THE TABLE
  76. C
  77. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR THE ENTRY NUMBER.
  78. C
  79.       INTEGER FUNCTION ZTBFND(KEY, KEYLEN, ARRAY)
  80.  
  81.       INTEGER KEYLEN, I, OFFSET, ENTRY, POINT
  82.       INTEGER ARRAY(*), KEY(*)
  83.  
  84.       ZTBFND = -1
  85.       IF(ARRAY(1) .NE.     116) RETURN
  86.       IF(KEYLEN   .LE.        0) RETURN
  87.       IF(KEYLEN   .GT. ARRAY(6)) RETURN
  88.       IF(ARRAY(4) .EQ.        0) RETURN
  89. C
  90.       OFFSET = 9
  91.       DO 10 ENTRY = 1, ARRAY(4)
  92.         IF(ARRAY(OFFSET) .EQ. KEYLEN) THEN
  93.           POINT = ARRAY(OFFSET + 1) - 1
  94.           DO 20 I = 1, KEYLEN
  95.             IF(KEY(I) .NE. ARRAY(I + POINT)) GO TO 30
  96.    20     CONTINUE
  97.           ZTBFND = ENTRY
  98.           RETURN
  99.         ENDIF
  100.    30   CONTINUE
  101.         OFFSET = OFFSET + ARRAY(3) + 2
  102.    10 CONTINUE
  103.  
  104.       RETURN
  105.       END
  106. C----------------------------------------------------------------------
  107. C
  108. C  ZTBGET - 05 MAR 84
  109. C           TIE LIBRARY
  110. C           TABLES SUPPLEMENTARY LIBRARY
  111. C
  112. C  GET AN ENTRY FROM THE TABLE
  113. C
  114. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR THE ENTRY NUMBER.
  115. C
  116.       INTEGER FUNCTION ZTBGET(KEY, KEYLEN, VALUES, ARRAY)
  117.  
  118.       INTEGER KEYLEN, I, OFFSET, ENTRY
  119.       INTEGER ARRAY(*), KEY(*), VALUES(*)
  120.       INTEGER ZTBFND
  121.  
  122.       ZTBGET = -1
  123. C
  124.       ENTRY = ZTBFND(KEY, KEYLEN, ARRAY)
  125.       IF(ENTRY .EQ. -1) RETURN
  126.  
  127.       ZTBGET = ENTRY
  128. *$XX$ RMJI 18MAY84: CHANGE 2 TO 10
  129.       OFFSET = (ARRAY(3) + 2) * (ENTRY - 1) + 10
  130.       DO 10 I = 1, ARRAY(3)
  131.         VALUES(I) =  ARRAY(OFFSET + I)
  132.    10 CONTINUE
  133.  
  134.       RETURN
  135.       END
  136. C----------------------------------------------------------------------
  137. C
  138. C  ZTBINT - 05 MAR 84
  139. C           TIE LIBRARY
  140. C           TABLES SUPPLEMENTARY LIBRARY
  141. C
  142. C  INITIALISE AN ARRAY AS A TABLE
  143. C
  144. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' (THE SIZE OF THE ARRAY
  145. C  OR SPECIFIED WIDTH IS WRONG) OR 'NOERR'. THERE IS
  146. C  AN OVERHEAD OF 8 LOCATIONS RESERVED BY THE ROUTINES. NOT ALL THE
  147. C  RESERVED LOCATIONS ARE USED AT PRESENT.
  148. C  AN ADDITIONAL OVERHEAD OF 2 LOCATIONS PER TABLE ENTRY IS USED TO
  149. C  RETAIN THE KEY LENGTH AND KEY LOCATION POINTERS.
  150. C  TABLE ENTRIES START AT THE BEGINNING OF ARRAY AND WORK UPWARDS
  151. C  KEY STORAGE STARTS AT THE END OF ARRAY AND WORK DOWNWARDS
  152. C
  153.       INTEGER FUNCTION ZTBINT(ARRAY, SIZE, WIDTH)
  154.  
  155.       INTEGER SIZE, WIDTH
  156.       INTEGER ARRAY(*)
  157.  
  158.       ZTBINT = -1
  159.       IF(WIDTH .LT. 0)          RETURN
  160.       IF(SIZE  .LT. WIDTH + 11) RETURN
  161.  
  162. C  IDENTIFY THE ARRAY AS A TABLE
  163.       ARRAY(1) = 116
  164. C  THE SIZE OF THE ARRAY
  165.       ARRAY(2) = SIZE
  166. C  THE WIDTH OF EACH ELEMENT
  167.       ARRAY(3) = WIDTH
  168. C  THE NUMBER OF ENTRIES
  169.       ARRAY(4) = 0
  170. C  THE NEXT FREE LOCATION FOR KEY ENTRY
  171.       ARRAY(5) = SIZE
  172. C  THE MAXIMUM KEY LENGTH YET SPECIFIED
  173.       ARRAY(6) = 0
  174. C  UNUSED
  175.       ARRAY(7) = 0
  176.       ARRAY(8) = 0
  177.  
  178.       ZTBINT = -2
  179.  
  180.       RETURN
  181.       END
  182. C----------------------------------------------------------------------
  183. C
  184. C  ZTBPUT - 05 MAR 84
  185. C           TIE LIBRARY
  186. C           TABLES SUPPLEMENTARY LIBRARY
  187. C
  188. C  PLACE AN ENTRY IN THE TABLE (IF IT IS NOT ALREADY THERE)
  189. C
  190. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR', 'EOF'
  191. C  OR THE ENTRY NUMBER.
  192. C
  193.       INTEGER FUNCTION ZTBPUT(KEY, KEYLEN, VALUES, ARRAY)
  194.  
  195.       INTEGER KEYLEN, I, OFFSET, ENTRY, FREE
  196.       INTEGER ARRAY(*), KEY(*), VALUES(*)
  197.       INTEGER ZTBFND
  198.  
  199.       ZTBPUT = -1
  200.       IF(ARRAY(1) .NE.     116) RETURN
  201.       IF(KEYLEN   .LE.        0) RETURN
  202. C
  203. C  IF THE KEY ALREADY EXISTS IN THE TABLE THEN JUST UPDATE THE VALUES
  204. C
  205.       ENTRY = ZTBFND(KEY, KEYLEN, ARRAY)
  206.       IF(ENTRY .NE. -1) THEN
  207.         ZTBPUT = ENTRY
  208.         OFFSET = (ARRAY(3) + 2) * (ENTRY - 1) + 10
  209.         DO 50 I = 1, ARRAY(3)
  210.           ARRAY(OFFSET + I) = VALUES(I)
  211.    50   CONTINUE
  212.         RETURN
  213.       ENDIF
  214. C
  215. C  CHECK THAT THERE IS SPACE TO PLACE THE NEW ENTRY
  216. C
  217.       ZTBPUT = -100
  218.       FREE = ARRAY(5) - 8 -
  219.      +       ((ARRAY(3) + 2) * ARRAY(4))
  220.       IF(FREE .LT. (KEYLEN + ARRAY(3) + 2)) RETURN
  221.  
  222.       ARRAY(4) = ARRAY(4) + 1
  223.       ZTBPUT = ARRAY(4)
  224.       OFFSET = (ARRAY(3) + 2) * (ARRAY(4) - 1) + 9
  225.       IF(KEYLEN .GT. ARRAY(6)) ARRAY(6) = KEYLEN
  226.  
  227.       ARRAY(OFFSET)   = KEYLEN
  228.       ARRAY(OFFSET+1) = ARRAY(5) - KEYLEN + 1
  229.       DO 10 I = 1, ARRAY(3)
  230.         ARRAY(OFFSET + 1 + I) = VALUES(I)
  231.    10 CONTINUE
  232.  
  233.       ARRAY(5) = ARRAY(5) - KEYLEN
  234.       DO 20 I = 1, KEYLEN
  235.         ARRAY(ARRAY(5) + I) = KEY(I)
  236.    20 CONTINUE
  237.  
  238.       RETURN
  239.       END
  240. C----------------------------------------------------------------------
  241. C
  242. C  ZTBTYP - 05 MAR 84
  243. C           TIE LIBRARY
  244. C           TABLES SUPPLEMENTARY LIBRARY
  245. C
  246. C  RETURN DETAILS ON A TABLE
  247. C
  248. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' (THE ARRAY IS NOT
  249. C  INITIALISED AS A TABLE) OR 'NOERR'.
  250. C
  251.       INTEGER FUNCTION ZTBTYP(ARRAY, WIDTH, ENTRYS, FREE, MAXKEY)
  252.  
  253.       INTEGER WIDTH, ENTRYS, FREE, MAXKEY
  254.       INTEGER ARRAY(*)
  255.  
  256.       ZTBTYP = -1
  257.       IF(ARRAY(1) .NE. 116) RETURN
  258.  
  259. C  THE WIDTH OF EACH ELEMENT
  260.       WIDTH = ARRAY(3)
  261. C  THE NUMBER OF ENTRIES
  262.       ENTRYS = ARRAY(4)
  263. C  THE AMOUNT OF FREE SPACE LEFT
  264.       FREE = ARRAY(5) - 8 -
  265.      +       ((ARRAY(3) + 2) * ARRAY(4))
  266. C  THE MAXIMUM KEY LENGTH YET SPECIFIED
  267.       MAXKEY = ARRAY(6)
  268.  
  269.       ZTBTYP = -2
  270.  
  271.       RETURN
  272.       END
  273.